home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / pcboard / pwrap110.zip / PCBWRAP.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-10  |  17KB  |  468 lines
  1. {$M 8192,0,655360}
  2. {$N-,E- no math support needed}
  3. {$X- function calls may not be discarded}
  4. {$I- disable I/O checking (trap errors by checking IOResult)}
  5.  
  6. PROGRAM wrapPCBoardDirfile;
  7. (*--------------------------------------------------------------------------
  8.  
  9.                                 REVISION HISTORY
  10.  
  11. v1.00  : 1993/07/14.  First public release.
  12. v1.00a : 1993/08/19.  Cosmetic corrections in .DOC and .DIZ files.
  13. v1.01  : 1993/08/27.  Fixed bug: would not properly process files in
  14.                           directories other than the current one.
  15. v1.01a : 1993/09/09.  Added ability to set right margin (SET margin=xxx).
  16.                       Now displays program ID & info. only if an error is
  17.                           encountered.  (Less display "clutter".)
  18. v1.02  : 1993/09/16.  Increased left margin flexibility: can be any width,
  19.                           except that it cannot exceed the difference between
  20.                           the right margin specification and 44.
  21.                       More cosmetic work on .DOC file.
  22. v1.03  : 1993/11/01.  Quashed minor bug: would loop if line did not wrap.
  23. v1.04  : 1993/12/01.  Now preserves blank lines outside of descriptions.
  24. v1.05  : 1993/12/09.  Now preserves original file date and time.
  25. v1.06  : 1994/08/09.  Reworked source code, major overhaul - much more
  26.                           robust and efficient (and no larger either!).
  27.                       Now deletes control codes and box/ line drawing chars.
  28.                       Now preserves ALL blank lines.
  29. v1.10  : 1996/04/10.  Polished source code a little, maybe slightly faster
  30.                         and more robust now.
  31.  
  32. --------------------------------------------------------------------------*)
  33. (*
  34.  example of a description, with two possible "prepipe|postpipe" specifications
  35.  
  36. PKZ204G.EXE    203019  02-08-93  PKZIP/PKUNZIP v2.04g; PKWare's compression
  37.  | utilities. More, minor bug fixes relative to version 2.04e See V204G.NEW for
  38.  | details; by Phil Katz/PKWare
  39.  ^
  40.  ^<- prepipe|postpipe of 1:1
  41.  
  42. PKZ204G.EXE    203019  02-08-93  PKZIP/PKUNZIP v2.04g; PKWare's compression
  43.                                | utilities. More, minor bug fixes relative to
  44.                                | version 2.04e See V204G.NEW for details; by
  45.                                | Phil Katz/PKWare
  46.     prepipe|postpipe of 31:1 ->^
  47. *)
  48.  
  49. USES DOS;
  50. TYPE
  51.   FList = ^FNode;
  52.   FNode = RECORD
  53.             fName: DIRSTR;    { Full file names of files to process.    }
  54.             Next: FList;
  55.           END;
  56.  
  57. CONST
  58.   colon = #58;  pipe = #124;  { "pipe" is the "|" symbol, these are my  }
  59.   hyphen = #45; space = #32;  { simple ways of minimizing typing errors }
  60.   minwidth = 44;              { minimum width of descriptions           }
  61.   maxleft  = 78;              { maximum LEFT margin, including the      }
  62.                               { spaces before and after the pipe        }
  63. VAR  { GLOBAL vars }
  64.   FileList    : FList;        { Singly linked list of files to process. }
  65.   nostrip     : BOOLEAN;      { remove "Files: ", "Uploaded by: ", etc? }
  66.                               { (read from a DOS environment variable)  }
  67.   prepipe,                    { spaces before the pipe                  }
  68.   postpipe    : STRING;       { spaces after  the pipe                  }
  69.   rightmargin : BYTE;         { right margin as a number                }
  70.  
  71. PROCEDURE WriteStr (CONST s: STRING); FORWARD;
  72. PROCEDURE ShowHelp (problem : BYTE);
  73. (*
  74.   If any *foreseen* errors arise, we are sent
  75.   here to give a little help and exit (relatively) peacefully
  76. *)
  77. CONST
  78.   NL = #13#10;
  79. VAR
  80.   message : STRING [79];
  81. BEGIN
  82.   WriteStr ('PCBWrap v1.10 - Free DOS utility: PCBoard filelist offline reformatter.');
  83.   WriteStr ('April 10, 1996. Copyright (c) 1996 by David Daniel Anderson - Reign Ware.'+NL);
  84.   WriteStr ('Usage:  PCBWrap file(s)_to_wrap [prepipe[:postpipe]] (1..79, default = 1:1)'+NL);
  85.   IF problem > 0 THEN BEGIN
  86.     CASE problem OF
  87.       1 : message := 'The difference between the right and left margins must be 44 or greater.';
  88.       2 : message := 'The second parameter is NOT a valid numeric!';
  89.       3 : message := 'No files found.  First parameter must be a valid file specification.';
  90.       6 : message := 'You cannot just specify a path, add "*.*" or "\*.*" for all files.';
  91.       7 : message := 'Error opening, closing, or renaming a file.  Original may be renamed!';
  92.       ELSE  message := 'Unknown error.';
  93.     END;
  94.     WriteStr ('Error encountered:'); WriteStr (message);
  95.   END;
  96.   Halt (problem);
  97. END;
  98.  
  99. PROCEDURE CheckIO;
  100. BEGIN
  101.   IF IOResult <> 0 THEN ShowHelp (7);
  102. END;
  103.  
  104. FUNCTION IsDir (CONST FileName: PATHSTR): BOOLEAN;
  105. VAR
  106.   Attr  : WORD;
  107.   cFile : FILE;
  108. BEGIN
  109.   Assign (cFile, FileName);
  110.   GetFAttr (cFile, Attr);
  111.   IF (DosError = 0) AND ((Attr AND Directory) = Directory)
  112.     THEN IsDir := TRUE
  113.     ELSE IsDir := FALSE;
  114. END;
  115.  
  116. FUNCTION GetFilePath (CONST PSTR: PATHSTR; VAR sDir: DIRSTR): PATHSTR;
  117. VAR
  118.   jPath : PATHSTR;  { file path,       }
  119.   jDir  : DIRSTR;   {      directory,  }
  120.   jName : NAMESTR;  {      name,       }
  121.   jExt  : EXTSTR;   {      extension.  }
  122. BEGIN
  123.   jPath := PSTR;
  124.   IF jPath = '' THEN jPath := '*.*';
  125.   IF (NOT (jPath [Length (jPath)] IN [':', '\'])) AND IsDir (jPath) THEN
  126.     jPath := jPath + '\';
  127.   IF (jPath [Length (jPath)] IN [':', '\']) THEN
  128.     jPath := jPath + '*.*';
  129.  
  130.   FSplit (FExpand (jPath), jDir, jName, jExt);
  131.   jPath := jDir + jName+ jExt;
  132.  
  133.   sDir := jDir;
  134.   GetFilePath := jPath;
  135. END;
  136.  
  137. PROCEDURE WriteStr (CONST s: STRING);
  138. BEGIN
  139.   WriteLn (s);
  140. END;
  141.  
  142. PROCEDURE OpenFiles (VAR file_in, file_out : TEXT; Name1, Name2 : STRING);
  143. BEGIN
  144.   Assign (file_in, Name1);
  145.   Reset (file_in);         CheckIO;
  146.   Assign (file_out, Name2);
  147.   Rewrite (file_out);      CheckIO;
  148. END;
  149.  
  150. FUNCTION GetRightMargin : BYTE;
  151. CONST
  152.   default_rm = 78;        { default RIGHT margin }
  153. VAR
  154.   rm       : SHORTINT;    { right margin as an integer }
  155.   valerr   : INTEGER;     { used when converting env var "margin" to number }
  156. BEGIN
  157.   Val (GetEnv ('margin'), rm, valerr);
  158.   IF (valerr <> 0)
  159.   THEN rm := default_rm
  160.   ELSE
  161.     IF NOT rm IN [minwidth + 3..minwidth + 3 + maxleft]
  162.     THEN rm := default_rm;
  163.   GetRightMargin := rm;
  164. END;
  165.  
  166. PROCEDURE CreateString (digits : STRING; VAR longstr : STRING);
  167. (* Create a string ("longstr") "digits"/"slen" in length *)
  168. VAR
  169.   slen     : BYTE;        { numeric of string containing numbers needed   }
  170.   pcode    : INTEGER;     { error code:
  171.   will be non-zero if strings are not numbers   }
  172. BEGIN
  173.   Val (digits, slen, pcode);
  174.   IF (pcode <> 0) THEN
  175.     ShowHelp (1);   { out of range }
  176.   IF NOT (slen IN [1..maxleft]) THEN
  177.     ShowHelp (2);     { numeric conversion error }
  178.   longstr [0] := Chr (slen);
  179.   FillChar (longstr [1], slen, space);
  180. END;
  181.  
  182. FUNCTION GetLeftMargin (VAR pre_p, post_p : STRING) : BYTE;
  183. (*
  184.   Determine number of spaces to put before and after the pipe character
  185.    (based on the second command line parameter, or a default)
  186. *)
  187. VAR
  188.   PSTR     : STRING [5];  { entire string containing numbers needed       }
  189. BEGIN
  190. (*
  191.   If the second parameter has a colon, the number before the colon will be
  192.   "pre_p", and the number after will be "post_p".
  193.   If a colon is not present, pre_p should be entire parameter (post_p=1).
  194. *)
  195.   PSTR := ParamStr (2); {first parameter is filespec, second is dimensions }
  196.   IF ((Pos (colon, PSTR)) > 1) THEN
  197.   BEGIN
  198.     CreateString (Copy (PSTR, 1, ((Pos (colon, PSTR)) - 1)), pre_p);
  199.     CreateString (Copy (PSTR, ((Pos (colon, PSTR)) + 1), Length (PSTR)), post_p);
  200.   END
  201.   ELSE
  202.     CreateString (PSTR, pre_p);
  203.   GetLeftMargin := Length (pre_p+ pipe+ post_p);
  204. END;
  205.  
  206. FUNCTION SqueezeStr (longstr : STRING) : STRING;
  207. (* Remove extra spaces, low and most of high ASCII, and leading pipes *)
  208. VAR newstr : STRING;
  209.   index  : BYTE; { hold our place in string }
  210. BEGIN
  211.   newstr := longstr;
  212.   FOR index := 1 TO Length (newstr) DO  {strip box/line chars, control codes}
  213.     IF Ord (newstr [index]) IN [0..31, 169, 170, 174..223, 240..245, 247..250, 254, 255]
  214.     THEN newstr [index] := space;
  215.  
  216.   WHILE (Length (newstr) > 1) AND (Pos (space+space, newstr) <> 0)
  217.     DO Delete (newstr, Pos (space+ space, newstr), 1);
  218.  
  219.   WHILE (newstr <> '') AND (newstr [Length (newstr)] = space)
  220.     DO Dec (newstr [0]);
  221.  
  222.   WHILE (newstr <> '') AND (newstr [1] IN [space, pipe])
  223.     DO Delete (newstr, 1, 1);
  224.  
  225.   SqueezeStr := newstr;
  226. END;
  227.  
  228. FUNCTION WrapLine (VAR thefile : TEXT; theline : STRING) : STRING;
  229. (* Split line after rightmargin character or nearest preceding space *)
  230. VAR
  231.   parta, partb  : STRING;    { first and second part of line }
  232.   breakchar    : STRING [1]; { character which will eventually be a space }
  233.   breakfound   : BOOLEAN;
  234.   breakpos     : BYTE;
  235. BEGIN
  236.   breakpos   := rightmargin + 2;
  237.   breakfound := FALSE;
  238. (*
  239.   Search for a space or a hyphen or the ASCII 255 non-displaying char,
  240.   by decrementing the breakpos while checking validity
  241. *)
  242.   WHILE ((NOT breakfound) AND (breakpos > Length (prepipe+ postpipe) + 2)) DO
  243.   BEGIN
  244.     Dec (breakpos);
  245.     breakfound := theline [breakpos] IN [space, hyphen, #255];
  246.   END;
  247.   IF NOT breakfound {if unable to find a valid breakpoint, break at max width}
  248.   THEN breakpos := rightmargin + 1;
  249.  
  250.   parta     := Copy (theline, 1, breakpos - 1);
  251.   partb     := Copy (theline, breakpos + 1, Length (theline) - (breakpos));
  252.   breakchar := theline [breakpos];
  253.  
  254.   IF NOT (breakchar [1] IN [space, #255]) THEN {save non-blank breakchar}
  255.     IF breakpos <= rightmargin
  256.       THEN parta := parta + breakchar
  257.       ELSE partb := breakchar + partb;
  258. (*
  259.   Write the first part to the file,
  260.   and then return the second part (after adding prepipe and postpipe).
  261. *)
  262.   WriteLn (thefile, parta);
  263.   WrapLine := (prepipe+ pipe+ postpipe+ partb);
  264. END;
  265.  
  266. PROCEDURE ProcessLine (VAR nextline, thisline : STRING);
  267. CONST
  268.   files1 = 'Files: ';           {7}
  269.   files2 = '(Files: ';          {8}
  270.   uplby1 = 'Uploaded by: ';    {13}
  271.   uplby2 = 'Uploaded By: ';    {13}
  272.   dcount = 'Download Count: '; {16}
  273. BEGIN
  274. (*
  275.   First remove upload status lines (unless otherwise instructed),
  276.   then remove spaces ("SqueezeStr" function)
  277. *)
  278.   IF (NOT (nostrip)) AND (Ord (nextline [0]) > 40) THEN
  279.     IF ((Pos (files1, nextline) = 34) OR
  280.        (Pos (files2, nextline) = 34) OR
  281.        (Pos (uplby1, nextline) = 34) OR
  282.        (Pos (uplby2, nextline) = 34) OR
  283.        (Pos (dcount, nextline) = 34))
  284.     THEN { remove that description line }
  285.       nextline := Copy (nextline, 1, 33);
  286. (*
  287.   If the next line still exists, then join current and next line with a
  288.   space between them for a word delimiter.  However, if the last char of
  289.   the current line is a hyphen, and the character preceding it is -not-
  290.   a space, then DO NOT add a space.  This is to force hyphenated words
  291.   to reconnect (eg. "hyphen-ation" instead of "hyphen- ation").
  292. *)
  293.   nextline := SqueezeStr (nextline);
  294.   IF (Length (nextline) > 0) AND (thisline [Length (thisline)] <> space)
  295.   THEN
  296.     IF NOT ((thisline [Length (thisline)] = hyphen) AND
  297.        (thisline [Length (thisline) - 1] <> space))
  298.     THEN thisline := thisline+ space;
  299.  
  300.   thisline := thisline+ nextline;
  301. END;
  302.  
  303. FUNCTION IsFirstLine (currentline : STRING) : BOOLEAN;
  304. VAR isfirst : BOOLEAN;    { is this the first line of a file desc?   }
  305.   valsize   : LONGINT;    { filesize }
  306.   valcode   : INTEGER;    { will give error if filesize not a number }
  307. BEGIN
  308. (*
  309.   Determine a valid first line by looking for a non-space/ control char in
  310.   the first position, and verifying file size, date, and proper spacing
  311.   between the size and date (file size is a number in columns 15-21).
  312. *)
  313.   isfirst := FALSE;
  314.   IF ((Length (currentline) > 30) AND (currentline [1] > space)) THEN BEGIN
  315.     Val (Copy (currentline, 15, 7), valsize, valcode);
  316.     IF (valcode = 0) THEN
  317.       isfirst := ((currentline [26] = hyphen) AND (currentline [29] = hyphen) AND
  318.       (currentline [22] = space)  AND (currentline [23] = space));
  319.   END;
  320.   IsFirstLine := isfirst;
  321. END;
  322.  
  323. PROCEDURE MakeNewFile (VAR source, dest : TEXT); { actually rewrite the file }
  324. VAR
  325.   crnline,                { the line currently on hold, already processed }
  326.   freshline : STRING;     { the line just read, now being processed       }
  327.   indesc,                 { have we found a first line of a description ? }
  328.   first     : BOOLEAN;    { if this is first line of FILE, do NOT write   }
  329.   { it to a new file unless it is the beginning   }
  330.   { of a new description                          }
  331. BEGIN
  332.   first   := TRUE;        { Initialize some vars... }
  333.   indesc  := FALSE;
  334.   REPEAT
  335.     FillChar (freshline, SizeOf (freshline), 0);     { clear out old line !!! }
  336.     ReadLn (source, freshline);
  337.     IF ((freshline [1] = space) AND indesc) THEN {Process description line }
  338.       ProcessLine (freshline, crnline)    { Join lines and pack the result }
  339.     ELSE BEGIN { First char not a space, or not processing a description, }
  340.       IF (NOT first) THEN
  341.         WriteLn (dest, crnline); {just write the processed line, and move on}
  342.       crnline := freshline;
  343.       indesc := IsFirstLine (crnline);  { Perhaps it starts a new filedesc }
  344.       IF indesc THEN                 { YES!, we are in a new description! }
  345.         crnline := Copy (crnline, 1, 31) + '  ' +
  346.         SqueezeStr (Copy (crnline, 34, Length (crnline) - 33)); {pack description}
  347.     END;
  348.     IF indesc THEN WHILE Length (crnline) > rightmargin DO
  349.       crnline := WrapLine (dest, crnline);
  350.     first := FALSE;
  351.   UNTIL EoF (source);             { loop back to read another line - PHEW! }
  352.   WriteLn (dest, crnline);       { last line of file, was already processed }
  353. END;
  354.  
  355. PROCEDURE BuildFileList (fPath: PATHSTR; fDir: DIRSTR);
  356. VAR
  357.   nFiles: WORD;
  358.   cFile: SEARCHREC;
  359.   Anchor, TempNode: FList;
  360.  
  361. BEGIN
  362.   nFiles := 0;
  363.   Anchor := NIL;
  364.   FileList := NIL;
  365.  
  366.   FindFirst (fPath, Archive, cFile);
  367.   WHILE DosError = 0 DO  { Add to linked list }
  368.   BEGIN
  369.       Inc (nFiles);
  370.       New (TempNode);
  371.       TempNode^.fName := fDir + cFile.Name;
  372.       TempNode^.Next := NIL;
  373.  
  374.       IF FileList <> NIL
  375.         THEN FileList^.Next := TempNode
  376.         ELSE Anchor := TempNode;
  377.       FileList := TempNode;
  378.     FindNext (cFile);
  379.   END;
  380.   FileList := Anchor;
  381.  
  382.   IF (nFiles = 0) THEN ShowHelp (3);
  383.   WriteLn ('PCBWrap found ', nFiles, ' file(s) to process.');
  384. END;
  385.  
  386. PROCEDURE ProcessFiles (sdir: DIRSTR);
  387. { Traverse linked list, processing each file. }
  388. CONST
  389.   destfname = 'pwraptmp.dst';
  390.   tempfname = 'pwraptmp.tmp';
  391.  
  392. VAR
  393.   sfn, dfn, tfn : PATHSTR;  { Source/ Dest/ Temp FileName, including dir }
  394.   infile, outfile : TEXT; { files read from/ written to                }
  395.   filedt    : LONGINT;    { file date and time, to preserve original   }
  396.   numdone   : WORD;       { numdone is number of files wrapped         }
  397.  
  398.   TempNode: FList;
  399.   pNum: BYTE;
  400.   ArcPos: BYTE;
  401.   fExt: EXTSTR;
  402.  
  403. BEGIN
  404.   dfn := sdir + destfname;
  405.   tfn := sdir + tempfname;
  406.  
  407.   numdone := 0;
  408.  
  409.   WHILE FileList <> NIL DO BEGIN
  410.     WITH FileList^ DO BEGIN
  411.       Inc (numdone);
  412.       sfn := fName;
  413.  
  414.       Write ('Wrapping ', sfn);    { tell user this file is being processed }
  415.       OpenFiles (infile, outfile, sfn, dfn);
  416.       MakeNewFile (infile, outfile);
  417.       WriteStr (', done!');        { tell user this file has been processed }
  418. (*
  419.   Swap file names, preserving the original date and time
  420.    (need to "flush" file so new date/ time sticks)
  421. *)
  422.       GetFTime (infile, filedt);   Close (infile); CheckIO;
  423.  
  424.       Close (outfile); CheckIO;    Reset (outfile); CheckIO;
  425.       SetFTime (outfile, filedt);  Close (outfile); CheckIO;
  426.  
  427.       Rename (infile, tfn); CheckIO;
  428.       Rename (outfile, sfn); CheckIO;
  429.  
  430.       Erase (infile); CheckIO;
  431.     END;
  432.     TempNode := FileList;
  433.     FileList := FileList^. Next; { Clean up after ourselves. }
  434.     Dispose (TempNode);
  435.   END;
  436.   WriteLn ('PCBWrapped ', numdone, ' file(s).');
  437. END;
  438.  
  439. VAR
  440.   fPath: PATHSTR;
  441.   fDir: DIRSTR;
  442.  
  443. (* BEGIN the "main" program *)
  444. BEGIN
  445. (*
  446.   Initialize some variables.
  447.   Prepipe and postpipe begin as single spaces.
  448.   The user must pass a filename (first parameter), and
  449.   may optionally pass a margin specification (second parameter),
  450.   which must allow at least 44 characters for the description.
  451. *)
  452.   IF NOT (ParamCount IN [1..2]) THEN ShowHelp (0);
  453.   nostrip := (GetEnv ('NOSTRIP') = 'true');
  454.  
  455. (* Get margin specifications *)
  456.   rightmargin := GetRightMargin;
  457.   prepipe  := space;
  458.   postpipe := space;
  459.   IF (ParamCount = 2) THEN
  460.     IF ((rightmargin - (GetLeftMargin (prepipe, postpipe))) < minwidth) THEN
  461.       ShowHelp (1);
  462.  
  463. (* Get file specification, and the process files. *)
  464.   fPath := GetFilePath (ParamStr (1), fDir);
  465.   BuildFileList (fPath, fDir);   { Build list of files. }
  466.   ProcessFiles (fDir);
  467. END.
  468.